home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt40s1.arc / EDITSTRI.MOD < prev    next >
Text File  |  1987-09-08  |  19KB  |  446 lines
  1. (*--------------------------------------------------------------------------*)
  2. (*          Edit_String  -- Edit a string using keypad keys                 *)
  3. (*--------------------------------------------------------------------------*)
  4.  
  5. FUNCTION Edit_String( VAR In_Str      : AnyStr;
  6.                           Buffer_Len  : INTEGER;
  7.                           Start_X     : INTEGER;
  8.                           X           : INTEGER;
  9.                           Y           : INTEGER;
  10.                           MaxWidth    : INTEGER;
  11.                           Force_Case  : BOOLEAN;
  12.                           Status_Line : INTEGER  ) : CHAR;
  13.  
  14. (*--------------------------------------------------------------------------*)
  15. (*                                                                          *)
  16. (*     Function:  Edit_String                                               *)
  17. (*                                                                          *)
  18. (*     Purpose:   Provides for editing a string using keypad keys.          *)
  19. (*                                                                          *)
  20. (*     Callling Sequence:                                                   *)
  21. (*                                                                          *)
  22. (*        Ch := Edit_String( VAR  In_Str     : AnyStr;                      *)
  23. (*                                Buffer_Len : INTEGER;                     *)
  24. (*                                Start_X    : INTEGER;                     *)
  25. (*                                X          : INTEGER;                     *)
  26. (*                                Y          : INTEGER;                     *)
  27. (*                                MaxWidth   : INTEGER;                     *)
  28. (*                                Force_Case : BOOLEAN;                     *)
  29. (*                                Status_Line: INTEGER ) : CHAR;            *)
  30. (*                                                                          *)
  31. (*           In_Str      --- String to be edited                            *)
  32. (*           Buffer_Len  --- Maximum length allowed for In_Str              *)
  33. (*           Start_X     --- Column to display string                       *)
  34. (*           X           --- Initial edit position in string                *)
  35. (*           Y           --- Row to display string                          *)
  36. (*           MaxWidth    --- Maximum width of display field for string      *)
  37. (*                           being edited -- horizontal scrolling will be   *)
  38. (*                           used if necessary.                             *)
  39. (*           Force_Case  --- TRUE to force input to upper case              *)
  40. (*           Status_Line --- Display edit status on this line if > 0;       *)
  41. (*                           else no status line display.                   *)
  42. (*           Ch          --- Character terminating edit of line             *)
  43. (*                                                                          *)
  44. (*     Calls:    DUPL                                                       *)
  45. (*               GoToXY                                                     *)
  46. (*               UpCase                                                     *)
  47. (*               KeyPressed                                                 *)
  48. (*               Substr                                                     *)
  49. (*               INSERT                                                     *)
  50. (*               DELETE                                                     *)
  51. (*               Read_Kbd                                                   *)
  52. (*               MsDos                                                      *)
  53. (*               Stuff_Kbd_Buf                                              *)
  54. (*                                                                          *)
  55. (*     Remarks:                                                             *)
  56. (*                                                                          *)
  57. (*        Here is a list of the control characters used (including IBM PC   *)
  58. (*        function keys):                                                   *)
  59. (*                                                                          *)
  60. (*        ^A   Move back 1 word, nondestructive [Ctrl-LeftArrow]            *)
  61. (*        ^B   Save current buffer in undo buffer                           *)
  62. (*        ^C   End of input; accept what is currently visible [Ctrl-Break]  *)
  63. (*        ^D   Move forward one [RightArrow]                                *)
  64. (*        ^F   Move forward 1 word [Ctrl-RightArrow]                        *)
  65. (*        ^G   Delete character forward [DEL]                               *)
  66. (*        ^H   Move back 1, destructive (same as ASCII DEL) [BackSpace]     *)
  67. (*        ^J   End of input; accept entire buffer [Ctrl-Enter]              *)
  68. (*        ^L   Look for char: reads a character, advances cursor to match   *)
  69. (*        ^M   End of input; accept text [Enter]                            *)
  70. (*        ^P   Accept next character as-is (control character prefix)       *)
  71. (*        ^Q   Move to beginning of line, nondestructive [Home]             *)
  72. (*        ^R   Move to end of line [End]                                    *)
  73. (*        ^S   Move back 1, nondestructive [LeftArrow]                      *)
  74. (*        ^T   Delete line forward [Ctrl-End]                               *)
  75. (*        ^U   Copy undo buffer into current buffer (undo)                  *)
  76. (*        ^V   Insert on/off [INS]                                          *)
  77. (*        ^Y   Delete line                                                  *)
  78. (*        DEL  Move back 1, destructive (same as ^H) (ASCII DEL) [Ctrl-BS]  *)
  79. (*        ESC  End of input; set result to null string and return.          *)
  80. (*                                                                          *)
  81. (*--------------------------------------------------------------------------*)
  82.  
  83. TYPE
  84.    Edit_Record = RECORD
  85.                     BufLen : BYTE;
  86.                     S      : AnyStr;
  87.                  END;
  88.  
  89. CONST
  90.    ESC = ^[                        (* Escape character *);
  91.    DEL = #$7F                      (* Delete character *);
  92.  
  93. (* STRUCTURED *) CONST
  94.                                    (* Terminator characters *)
  95.  
  96.    TermChars : CharSet = [^C,^E,^J,^K,^M,^N,^[,^X];
  97.  
  98.                                    (* Legal chars in a 'word' *)
  99.  
  100.    WordChars : CharSet = ['0'..'9','A'..'Z','a'..'z'];
  101.  
  102. VAR
  103.    Insert_Mode  : BOOLEAN           (* TRUE = insert mode, FALSE = overwrite *);
  104.    WasChar      : BOOLEAN           (* TRUE if non-editing character         *);
  105.    ReDraw       : BOOLEAN           (* TRUE to redraw line being edited      *);
  106.    Ch           : CHAR              (* Current input editing character       *);
  107.    In_Str_Undo  : AnyStr            (* Undo buffer                           *);
  108.    In_String    : AnyStr            (* Working copy of string to be edited   *);
  109.    I            : INTEGER           (* General loop counter                  *);
  110.    L            : INTEGER           (* String length                         *);
  111.    LOld         : INTEGER           (* String length before current edit     *);
  112.    Regs         : RegPack           (* For calling DOS function $0a          *);
  113.    My_String    : Edit_Record       (* Edit record for DOS $0a editing       *);
  114.    X2           : INTEGER           (* X position in searches                *);
  115.    Disp_Length  : INTEGER           (* # of columns available for display    *);
  116.    Left_X       : INTEGER           (* Current leftmost column displayed     *);
  117.    First_Edit   : BOOLEAN           (* TRUE if first time editing string     *);
  118.  
  119. (*--------------------------------------------------------------------------*)
  120.  
  121. PROCEDURE Update_Edit_Status;
  122.  
  123. VAR
  124.    SaveX: INTEGER;
  125.    SaveY: INTEGER;
  126.  
  127. BEGIN (* Update_Edit_Status *)
  128.  
  129.    TextColor     ( Global_BackGround_Color );
  130.    TextBackGround( Global_ForeGround_Color );
  131.  
  132.    SaveX := WhereX;
  133.    SaveY := WhereY;
  134.  
  135.    GoToXY( 1 , Status_Line );
  136.  
  137.    WRITE(' Line ',Y:3,'   Column ',X:3);
  138.  
  139.    IF Insert_Mode THEN
  140.       WRITE('  Insert   ')
  141.    ELSE
  142.       WRITE('  Overwrite');
  143.  
  144.    TextColor     ( Global_ForeGround_Color );
  145.    TextBackGround( Global_BackGround_Color );
  146.  
  147.    ClrEol;
  148.  
  149.    GoToXY( SaveX, SaveY );
  150.  
  151. END   (* Update_Edit_Status *);
  152.  
  153. (*--------------------------------------------------------------------------*)
  154.  
  155. BEGIN (* Edit_String *)
  156.                                    (* Use DOS function $0a if requested *)
  157.    IF Use_Dos_Buffer_In THEN
  158.       BEGIN
  159.                                    (* Construct record for DOS $0a use  *)
  160.          WITH My_String DO
  161.             BEGIN
  162.                S                    := In_Str;
  163.                S[ ORD( S[0] ) + 1 ] := ^M;
  164.                BufLen               := 254;
  165.             END;
  166.                                    (* Move to position to display string *)
  167.          GoToXY( Start_X , Y );
  168.                                    (* Stuff F3 in keyboard buffer so string *)
  169.                                    (* is displayed.                         *)
  170.  
  171.          Stuff_Kbd_Buf( F3 SHL 8 , TRUE );
  172.  
  173.                                    (* Call DOS to do the editing.           *)
  174.          WITH Regs DO
  175.             BEGIN
  176.  
  177.                AH := $0A;
  178.                DS := SEG( My_String.BufLen );
  179.                DX := OFS( My_String.BufLen );
  180.  
  181.                MsDos( Regs );
  182.  
  183.             END;
  184.  
  185.          Edit_String := ^M;               (* Return the terminator *)
  186.          In_Str      := My_String.S;      (* Return updated string *)
  187.  
  188.          EXIT;
  189.  
  190.       END;
  191.                                    (* Initialize -- not using DOS $0a *)
  192.  
  193.    Insert_Mode  := Edit_Insert_Mode;
  194.    First_Edit   := Insert_Mode AND ( Start_X = X );
  195.  
  196.                                    (* Display the string to be edited *)
  197.    In_String   := In_Str;
  198.    In_Str_Undo := In_Str;
  199.  
  200.    GoToXY( Start_X , Y );
  201.  
  202.    LOld        := ORD( In_String[0] );
  203.    Left_X      := Start_X;
  204.  
  205.    WRITE( Substr( In_String, 1, MIN( LOld , MaxWidth ) ) );
  206.  
  207.    GoToXY( X , Y );
  208.                                    (* Display status line if requested *)
  209.    IF ( Status_Line > 0 ) THEN
  210.       Update_Edit_Status;
  211.                                    (* Begin main edit/input loop *)
  212.    REPEAT
  213.                                    (* Get current string length *)
  214.       LOld   := ORD(In_String[0]);
  215.                                    (* Assume no need to redraw  *)
  216.       ReDraw := FALSE;
  217.                                    (* Read input character *)
  218.       Read_Kbd( Ch );
  219.                                    (* Convert to upper case if requested *)
  220.       IF Force_Case THEN
  221.          Ch := UpCase( Ch );
  222.                                    (* Assume editing char found *)
  223.       WasChar := FALSE;
  224.                                    (* Check for keypad keys *)
  225.  
  226.       IF ( Ch = ESC ) THEN
  227.          IF KeyPressed THEN
  228.             BEGIN
  229.  
  230.                READ( Kbd , Ch );
  231.  
  232.                CASE ORD( Ch ) OF
  233.  
  234.                   Ctrl_L_Arrow: Ch := ^A;      (* Ctrl-LeftArrow  *)
  235.                   R_Arrow     : Ch := ^D;      (* RightArrow      *)
  236.                   Ctrl_R_Arrow: Ch := ^F;      (* Ctrl-RightArrow *)
  237.                   Del_Key     : Ch := ^G;      (* DEL             *)
  238.                   Home        : Ch := ^Q;      (* Home            *)
  239.                   End_Key     : Ch := ^R;      (* END             *)
  240.                   L_Arrow     : Ch := ^S;      (* LeftArrow       *)
  241.                   Ctrl_End_Key: Ch := ^T;      (* Ctrl-END        *)
  242.                   Ins_Key     : Ch := ^V;      (* INS             *)
  243.                   U_Arrow     : Ch := ^E;      (* Up-arrow        *)
  244.                   D_Arrow     : Ch := ^X;      (* Down-arrow      *)
  245.                   PgUp        : Ch := ^U;      (* PgUp            *)
  246.                   PgDn        : Ch := ^Y;      (* PgDn            *)
  247.                   ELSE          Ch := '?';     (* all unknowns    *)
  248.                                 Menu_Beep;
  249.  
  250.                END (* CASE *);
  251.             END
  252.          ELSE
  253.             BEGIN
  254.                ReDraw       := TRUE;
  255.                In_String[0] := #0;
  256.                X            := Start_X;
  257.             END;
  258.                                    (* Perform editing function *)
  259.       CASE Ch OF
  260.                                    (* Move to beginning of string *)
  261.          ^Q: X := Start_X;
  262.                                    (* Restart editing *)
  263.          ^U: BEGIN
  264.                 In_String := In_Str_Undo;
  265.                 X         := Start_X;
  266.                 ReDraw    := TRUE;
  267.              END;
  268.  
  269.          ^Y: BEGIN
  270.                 In_String[0] := #0;
  271.                 X            := Start_X;
  272.                 ReDraw       := TRUE;
  273.              END;
  274.                                    (* Move one word to left *)
  275.          ^A: BEGIN
  276.                 X2 := X - Start_X;
  277.                 WHILE ( ( X2 > 0 ) AND
  278.                         ( NOT ( In_String[X2] IN WordChars ) ) ) DO
  279.                     X2 := PRED( X2 );
  280.                 IF ( X2 > 0 ) THEN X2 := PRED( X2 );
  281.                 WHILE ( ( X2 > 0 ) AND ( In_String[X2] IN WordChars ) ) DO
  282.                    X2 := PRED( X2 );
  283.                 X := Start_X + X2;
  284.              END;
  285.                                    (* Save edited string in undo string *)
  286.  
  287.          ^B:  In_Str_Undo := In_String;
  288.  
  289.                                    (* Move 1 column to right *)
  290.  
  291.          ^D : IF (X - Start_X) < Buffer_Len THEN
  292.                  IF ( ( X - Start_X ) < LOld ) THEN
  293.                     X := SUCC( X );
  294.  
  295.                                    (* Move 1 word to right *)
  296.          ^F:  BEGIN
  297.                  X2 := SUCC( X - Start_X );
  298.                  L  := ORD( In_String[0] );
  299.                  IF ( X2 < L ) THEN X2 := SUCC( X2 );
  300.                  WHILE ( ( X2 <= L ) AND
  301.                          ( In_String[X2] IN WordChars ) ) DO X2 := SUCC( X2 );
  302.                  WHILE ( ( X2 <= L ) AND
  303.                          ( NOT ( In_String[X2] IN WordChars ) ) ) DO X2 := SUCC( X2 );
  304.                  X := PRED( Start_X + X2 );
  305.               END;
  306.                                    (* Search for character *)
  307.          ^L:  BEGIN
  308.                  Read_Kbd( Ch );
  309.                  L  := LOld;
  310.                  X2 := X - Start_X + 2;
  311.                  WHILE ( ( X2 <= L ) AND
  312.                          ( In_String[X2] <> Ch ) ) DO X2 := SUCC( X2 );
  313.                  IF ( X2 <= L ) THEN
  314.                     X := PRED( Start_X + X2 );
  315.                  Ch := ^L;
  316.               END;
  317.                                    (* Move to end of string *)
  318.          ^R,
  319.          ^N,
  320.          ^J:  X := Start_X + LOld;
  321.  
  322.                                    (* Delete character under cursor *)
  323.          ^G: BEGIN
  324.                 DELETE( In_String, X - PRED( Start_X ), 1 );
  325.                 ReDraw := TRUE;
  326.              END;
  327.                                    (* Destructive backspace *)
  328.          ^H,
  329.         DEL: IF ( X > Start_X ) THEN
  330.                 BEGIN
  331.                    DELETE( In_String, X - Start_X, 1 );
  332.                    X      := PRED( X );
  333.                    ReDraw := TRUE;
  334.                 END;
  335.                                    (* Non-destructive backspace *)
  336.  
  337.          ^S: IF ( X > Start_X ) THEN X := PRED( X );
  338.  
  339.                                    (* Get control character *)
  340.          ^P: BEGIN
  341.                 Read_Kbd( Ch );
  342.                 WasChar := TRUE;
  343.              END;
  344.                                    (* Delete to end of line *)
  345.  
  346.          ^T: BEGIN
  347.                 DELETE( In_String, X - PRED( Start_X ), LOld );
  348.                 ReDraw := TRUE;
  349.              END;
  350.                                    (* Toggle Insert/Overwrite Mode *)
  351.  
  352.          ^V: Insert_Mode := NOT Insert_Mode;
  353.  
  354.          ELSE
  355.              WasChar := NOT ( Ch IN TermChars ) AND
  356.                             ( Ch <> '?' );
  357.  
  358.       END (* CASE *);
  359.                                    (* Ordinary character -- check if *)
  360.                                    (* string must be extended.       *)
  361.       IF WasChar THEN
  362.          IF First_Edit THEN
  363.             BEGIN
  364.                In_String    := Ch;
  365.                X            := SUCC( Start_X );
  366.                ReDraw       := TRUE;
  367.             END
  368.          ELSE IF ( X - Start_X ) >= LOld THEN
  369.             BEGIN
  370.                In_String := In_String + Ch;
  371.                GoToXY( X , Y );
  372.                WRITE( Ch );
  373.                IF ( X - Start_X ) < Buffer_Len THEN
  374.                   X := SUCC( X );
  375.             END
  376.          ELSE
  377.                                    (* If insert mode ... *)
  378.             IF Insert_Mode THEN
  379.                BEGIN
  380.  
  381.                   INSERT( Ch, In_String,
  382.                           X - PRED( Start_X ) );
  383.  
  384.                   In_String := Substr( In_String, 1, Buffer_Len );
  385.  
  386.                   IF ( X - Start_X ) < Buffer_Len THEN
  387.                      X := SUCC( X );
  388.  
  389.                   ReDraw := TRUE;
  390.  
  391.                END
  392.             ELSE
  393.                BEGIN   (* If Overwrite mode ... *)
  394.  
  395.                   In_String[ X - PRED( Start_X ) ] := Ch;
  396.  
  397.                   GoToXY( X , Y );
  398.                   WRITE( Ch );
  399.  
  400.                   IF ( X - Start_X ) < Buffer_Len THEN
  401.                      X := SUCC( X );
  402.  
  403.                END;
  404.                                    (* Not first character edited any more *)
  405.       First_Edit := FALSE;
  406.                                    (* Set up horizontal scroll if needed *)
  407.  
  408.       L          := ORD( In_String[0] );
  409.       I          := Left_X;
  410.  
  411.       IF ( SUCC( X - Left_X ) > MaxWidth ) THEN
  412.          WHILE ( SUCC( X - Left_X ) > MaxWidth ) DO
  413.             Left_X := SUCC( Left_X )
  414.       ELSE
  415.          WHILE ( X < Left_X ) DO
  416.             Left_X := PRED( Left_X );
  417.  
  418.       ReDraw := ReDraw OR ( I <> Left_X );
  419.  
  420.                                    (* Redraw line if needed *)
  421.       IF ReDraw THEN
  422.          BEGIN
  423.             GoToXY( Start_X , Y );
  424.             L := MIN( ( Left_X - Start_X + L ), MaxWidth );
  425.             WRITE( Substr( In_String, SUCC( Left_X - Start_X ), L ) );
  426.             L := SUCC( WhereX - Start_X );
  427.             WHILE ( ( L < MaxWidth ) AND ( Y = WhereY ) ) DO
  428.                BEGIN
  429.                   WRITE( ' ' );
  430.                   L := SUCC( L );
  431.                END;
  432.          END;
  433.                                    (* Update status line *)
  434.  
  435.       GoToXY( ( X - Left_X + Start_X ) , Y );
  436.  
  437.       IF ( Status_Line > 0 ) THEN
  438.          Update_Edit_Status;
  439.  
  440.    UNTIL ( ( Ch IN TermChars ) AND ( NOT WasChar ) );
  441.  
  442.    Edit_String := Ch;                       (* Return the terminator *)
  443.    In_Str      := In_String;                (* Return updated string *)
  444.  
  445. END   (* Edit_String *);
  446.